home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / extract_archive < prev    next >
Encoding:
Text File  |  2000-01-12  |  1.3 KB  |  47 lines
  1. #!/usr/bin/perl
  2.  
  3. use strict qw(subs refs);
  4.  
  5. sub catsksz {
  6.     my ($input, $seek, $siz, $output) = @_;
  7.     my ($buf, $sz);
  8.  
  9.     while (($sz = sysread($input, $buf, $seek > 4096 ? 4096 : $seek))) {
  10.     $seek -= $sz;
  11.     last unless $seek > 0;
  12.     }
  13.     while (($sz = sysread($input, $buf, $siz > 4096 ? 4096 : $siz))) {
  14.     $siz -= $sz;
  15.     syswrite($output, $buf);
  16.     last unless $siz > 0;
  17.     }
  18. }
  19.  
  20. sub main {
  21.     my ($basename, $dir, $file) = @_;
  22.     my %data;
  23.  
  24.     eval `cat $basename.cz2.pl`;
  25.  
  26.     die "unable to find file $file in archive $basename.cz2" unless $data{$file};
  27.  
  28. #    system "head < $name.cz2 -c ". ($data{$file}[0] + $data{$file}[1]) ." | tail -c ". $data{$file}[1] ."| bzip2 -d | head -c ". ($data{$file}[2] + $data{$file}[3]) ." | tail -c ". $data{$file}[3] ." > $file.from_archive";
  29. #    system "./catsksz < $name.cz2 $data{$file}[0] $data{$file}[1] | bzip2 -d | ./catsksz $data{$file}[2] $data{$file}[3] > $file.from_archive";
  30.  
  31.     local *OUTPUT;
  32.     if (open OUTPUT, "-|") {
  33.     local *FILE;
  34.     open FILE, $dir ? ">$dir/$file" : ">&STDOUT";
  35.     catsksz(\*OUTPUT, $data{$file}[2], $data{$file}[3], \*FILE);
  36.     } else {
  37.     local *BUNZIP2;
  38.     open BUNZIP2, "| bzip2 -d";
  39.     local *ARCHIVE;
  40.     open ARCHIVE, "<$basename.cz2" or die "cannot open archive $basename.bz2";
  41.     catsksz(\*ARCHIVE, $data{$file}[0], $data{$file}[1], \*BUNZIP2);
  42.     exec 'true';
  43.     }
  44. }
  45.  
  46. main(@ARGV);
  47.